home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 15 / Amiga Plus Leser CD 15.iso / Tools / Development / AmigaTalk_X / intuition / Gadget.st < prev    next >
Encoding:
Text File  |  2002-03-13  |  8.8 KB  |  380 lines
  1. "-----------------------------------------------------------------------"
  2. " Gadget Class is an Abstract class for Intuition Gadgets.              "
  3. "-----------------------------------------------------------------------"
  4.  
  5. Class Gadget :Glyph
  6. [
  7.    getGadgetObject   " After all, this is an ABSTRACT CLASS!! "
  8.       super subclassResponsibility: 'getGadgetObject'.
  9.       ^ nil
  10. |
  11.    isDisabled: thisGadget ! gadgetFlags mask !
  12.       gadgetFlags <- GadgetFlags new.
  13.       mask        <- gadgetFlags at: #GFLG_DISABLED.
  14.  
  15.       (mask and: [<primitive 183 2 4 thisGadget>])
  16.          ifTrue: [ ^ true ].
  17.  
  18.       ^ false
  19. |
  20.    isSelected: thisGadget ! gadgetFlags mask !
  21.       gadgetFlags <- GadgetFlags new.
  22.       mask        <- gadgetFlags at: #GFLG_SELECTED.
  23.  
  24.       (mask and: [<primitive 183 2 4 thisGadget>])
  25.          ifTrue: [ ^ true ].
  26.  
  27.       ^ false
  28. |
  29.    "only needed because of GZZGADGET & REQGADGET type flags."
  30.    gadgetTypeIs: thisGadget
  31.       ^ <primitive 183 2 6 thisGadget>
  32. |
  33.    dispose: thisGadget
  34.       <primitive 183 0 thisGadget>.
  35. |
  36.    setStartPoint: thisGadget to: newPoint ! x y !  "newPoint  is leftEdge @ topEdge"
  37.       x <- newPoint x.
  38.       y <- newPoint y.
  39.  
  40.       <primitive 183 3 0 x thisGadget>.
  41.       <primitive 183 3 1 y thisGadget>.
  42. |
  43.    setGadgetSize: thisGadget to: sizePoint ! w h ! "sizePoint is width @ height"
  44.       w <- sizePoint x.
  45.       h <- sizePoint y.
  46.  
  47.       <primitive 183 3 2 w thisGadget>.
  48.       <primitive 183 3 3 h thisGadget>
  49. |
  50.    getStartPoint: thisGadget ! leftEdge topEdge !
  51.       leftEdge <- <primitive 183 2 0 thisGadget>.
  52.       topEdge  <- <primitive 183 2 1 thisGadget>.
  53.  
  54.       ^ leftEdge @ topEdge
  55. |
  56.    getGadgetSize: thisGadget ! width height !
  57.       width  <- <primitive 183 2 2 thisGadget>.
  58.       height <- <primitive 183 2 3 thisGadget>.
  59.  
  60.       ^ width @ height
  61. ]
  62.  
  63. "-----------------------------------------------------------------------"
  64. " BoolGadget Class implements messages specific only to boolean gadgets."
  65. "-----------------------------------------------------------------------"
  66.  
  67. Class BoolGadget :Gadget ! private !
  68. [
  69.    dispose
  70.       super dispose: private.
  71.  
  72.       ^ nil
  73. |
  74.    isDisabled
  75.       ^ (super isDisabled: private)
  76. |
  77.    isSelected
  78.       ^ (super isSelected: private)
  79. |
  80.    gadgetTypeIs
  81.       ^ (super gadgetTypeIs: private)
  82. |
  83.    "only needed because of GZZGADGET & REQGADGET type flags."
  84.    setGadgetType: newGadgetType
  85.       <primitive 183 3 6 newGadgetType private>
  86. |
  87.    getGadgetObject
  88.       ^ private
  89. |
  90.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  91.       super setStartPoint: private to: newPoint.
  92.  
  93.       ^ newPoint
  94. |   
  95.    setGadgetSizeTo: sizePoint
  96.       super setGadgetSize: private to: sizePoint.
  97.       
  98.       ^ sizePoint
  99. |
  100.    getStartPoint
  101.       ^ (super getStartPoint: private)
  102. |
  103.    getGadgetSize
  104.       ^ (super getGadgetSize: private)
  105. |
  106.    getFlags
  107.       ^ <primitive 183 2 4 private>
  108. |
  109.    setFlags: newFlags
  110.       <primitive 183 3 4 newFlags private>
  111. |
  112.    getActivation
  113.       ^ <primitive 183 2 5 private>
  114. |
  115.    setActivation: newActivation
  116.       <primitive 183 3 5 newActivation private>
  117. |
  118.    getGadgetID
  119.       ^ <primitive 183 2 7 private>
  120. |
  121.    setGadgetID: newGadgetID
  122.       <primitive 183 3 7 newGadgetID private>
  123. |
  124.    getNextGadget
  125.       ^ <primitive 183 2 8 private>
  126. |
  127.    setNextGadget: newNextGadgetObject
  128.       <primitive 183 3 8 newNextGadgetObject private>
  129. |
  130.    getITextString
  131.       ^ <primitive 183 2 9 private>
  132. |
  133.    getGadgetText            " which is an IntuiText Object "
  134.       ^ <primitive 183 2 18 private>
  135. |
  136.    setGadgetText: newIntuiTextObject
  137.       <primitive 183 3 9 newIntuiTextObject private>
  138. |
  139.    getRenderObject
  140.       ^ <primitive 183 2 10 private>
  141. |
  142.    setRender: newRenderObject " Either an Image, Border or IntuiText! "
  143.       <primitive 183 3 10 newRenderObject private>.
  144. |
  145.    getSelectObject
  146.       ^ <primitive 183 2 11 private>
  147. |
  148.    setSelect: newSelectObject " Either an Image, Border or IntuiText! "
  149.       <primitive 183 3 11 newSelectObject private>
  150. |
  151.    new
  152.       private <- <primitive 183 1>.
  153.  
  154.       self setGadgetType: 1.
  155.  
  156.       ^ self
  157. ]
  158.  
  159. "---------------------------------------------------------------------"
  160. " StrGadget Class implements messages specific only to string gadgets."
  161. "---------------------------------------------------------------------"
  162.  
  163. Class StrGadget :Gadget ! private !
  164. [
  165.    dispose
  166.       super dispose: private.
  167.  
  168.       ^ nil
  169. |
  170.    isDisabled
  171.       ^ (super isDisabled: private)
  172. |
  173.    isSelected
  174.       ^ (super isSelected: private)
  175. |
  176.    gadgetTypeIs
  177.       ^ (super gadgetTypeIs: private)
  178. |
  179.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  180.       super setStartPoint: private to: newPoint.
  181.  
  182.       ^ newPoint
  183. |   
  184.    setGadgetSizeTo: sizePoint
  185.       super setGadgetSize: private to: sizePoint.
  186.       
  187.       ^ sizePoint
  188. |
  189.    getStartPoint
  190.       ^ (super getStartPoint: private)
  191. |
  192.    getGadgetSize
  193.       ^ (super getGadgetSize: private)
  194. |
  195.    setBufferSize: newSize
  196.       <primitive 183 5 newSize private>
  197. |
  198.    getBufferSize
  199.       ^ <primitive 183 2 12 private>
  200. |
  201.    getFlags
  202.       ^ <primitive 183 2 4 private>
  203. |
  204.    setFlags: newFlags
  205.       <primitive 183 3 4 newFlags private>
  206. |
  207.    getActivation
  208.       ^ <primitive 183 2 5 private>
  209. |
  210.    setActivation: newActivation
  211.       <primitive 183 3 5 newActivation private>
  212. |
  213.    setGadgetType: newGadgetType
  214.       <primitive 183 3 6 newGadgetType private>.
  215. |
  216.    getGadgetID
  217.       ^ <primitive 183 2 7 private>
  218. |
  219.    setGadgetID: newGadgetID
  220.       <primitive 183 3 7 newGadgetID private>
  221. |
  222.    getNextGadget
  223.       ^ <primitive 183 2 8 private>
  224. |
  225.    setNextGadget: newNextGadgetObject
  226.       <primitive 183 3 8 newNextGadgetObject private>
  227. |
  228.    getITextString
  229.       ^ <primitive 183 2 9 private>
  230. |
  231.    getGadgetText
  232.       ^ <primitive 183 2 18 private>
  233. |
  234.    setGadgetText: newIntuiTextObject
  235.       <primitive 183 3 9 newIntuiTextObject private>
  236. |
  237.    getRender
  238.       ^ <primitive 183 2 10 private>
  239. |
  240.    setRender: newRenderObject " Either an Image or IntuiText! "
  241.       <primitive 183 3 10 newRenderObject private>
  242. |
  243.    getSelect
  244.       ^ <primitive 183 2 11 private>
  245. |
  246.    setSelect: newSelectObject " Either an Image or IntuiText! "
  247.       <primitive 183 3 11 newSelectObject private>
  248. |
  249.    getGadgetObject
  250.       ^ private
  251. |
  252.    new
  253.       private <- <primitive 183 1>.
  254.  
  255.       self setGadgetType: 4.
  256.  
  257.       ^ self
  258. ]
  259.  
  260. "------------------------------------------------------"
  261. " PropGadget Class implements messages specific only to"
  262. " proportional gadgets.                                "
  263. "------------------------------------------------------"
  264.  
  265. Class PropGadget :Gadget ! private !
  266. [
  267.    dispose
  268.       super dispose: private.
  269.  
  270.       ^ nil
  271. |
  272.    isDisabled
  273.       ^ (super isDisabled: private)
  274. |
  275.    isSelected
  276.       ^ (super isSelected: private)
  277. |
  278.    gadgetTypeIs
  279.       ^ (super gadgetTypeIs: private)
  280. |
  281.    "only needed because of GZZGADGET & REQGADGET type flags."
  282.    setGadgetType: newGadgetType
  283.       <primitive 183 3 6 newGadgetType private>
  284. |
  285.    getGadgetObject
  286.       ^ private
  287. |
  288.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  289.       super setStartPoint: private to: newPoint.
  290.  
  291.       ^ newPoint
  292. |   
  293.    setGadgetSizeTo: sizePoint
  294.       super setGadgetSize: private to: sizePoint.
  295.       
  296.       ^ sizePoint
  297. |
  298.    getStartPoint
  299.       ^ (super getStartPoint: private)
  300. |
  301.    getGadgetSize
  302.       ^ (super getGadgetSize: private)
  303. |
  304.    modifyProps: newFlags hPot: hp vPot: vp hBody: hb
  305.                 vBody: vb window: windowObject
  306.  
  307.       <primitive 183 4 newFlags hp vp hb vb windowObject private>.
  308. |
  309.    setProps: newFlags hPot: hp vPot: vp hBody: hb vBody: vb
  310.  
  311.       <primitive 183 6 newFlags hp vp hb vb private>
  312. |
  313.    getFlags
  314.       ^ <primitive 183 2 4 private>
  315. |
  316.    setFlags: newFlags
  317.       <primitive 183 3 4 newFlags private>
  318. |
  319.    getActivation
  320.       ^ <primitive 183 2 5 private>
  321. |
  322.    setActivation: newActivation
  323.       <primitive 183 3 5 newActivation private>
  324. |
  325.    getGadgetID
  326.       ^ <primitive 183 2 7 private>
  327. |
  328.    setGadgetID: newGadgetID
  329.       <primitive 183 3 7 newGadgetID private>
  330. |
  331.    getNextGadget
  332.       ^ <primitive 183 2 8 private>
  333. |
  334.    setNextGadget: newNextGadgetObject
  335.       <primitive 183 3 8 newNextGadgetObject private>
  336. |
  337.    getITextString
  338.       ^ <primitive 183 2 9 private>
  339. |
  340.    getGadgetText
  341.       ^ <primitive 183 2 18 private>
  342. |
  343.    setGadgetText: newIntuiTextObject
  344.       <primitive 183 3 9 newIntuiTextObject private>
  345. |
  346.    getRender
  347.       ^ <primitive 183 2 10 private>
  348. |
  349.    setRender: newRenderObject " Either an Image or IntuiText! "
  350.       <primitive 183 3 10 newRenderObject private>
  351. |
  352.    getSelect
  353.       ^ <primitive 183 2 11 private>
  354. |
  355.    setSelect: newSelectObject " Either an Image or IntuiText! "
  356.       <primitive 183 3 11 newSelectObject private>
  357. |
  358.    getPropFlags
  359.       ^ <primitive 183 2 13 private>
  360. |
  361.    getHPot
  362.       ^ <primitive 183 2 14 private>
  363. |
  364.    getVPot
  365.       ^ <primitive 183 2 15 private>
  366. |
  367.    getHBody
  368.       ^ <primitive 183 2 16 private>
  369. |
  370.    getVBody
  371.       ^ <primitive 183 2 17 private>
  372. |
  373.    new
  374.       private <- <primitive 183 1>.
  375.  
  376.       self setGadgetType: 3.
  377.  
  378.       ^ self
  379. ]
  380.